home *** CD-ROM | disk | FTP | other *** search
/ HyperLib 1997 Winter - Disc 1 / HYPERLIB-1997-Winter-CD1.ISO.7z / HYPERLIB-1997-Winter-CD1.ISO / オンラインウェア / PRG / MacPerl 506 appl folder.sit / MacPerl 506 appl folder / Mac_Perl_506r1m_appl / lib / dumpvar.pl < prev    next >
Perl Script  |  1994-12-26  |  1KB  |  44 lines
  1. package dumpvar;
  2.  
  3. # translate control chars to ^X - Randal Schwartz
  4. sub unctrl {
  5.     local($_) = @_;
  6.     return ¥$_ if ref ¥$_ eq "GLOB";
  7.     s/([¥001-¥037¥177])/'^'.pack('c',ord($1)^64)/eg;
  8.     $_;
  9. }
  10. sub main'dumpvar {
  11.     ($package,@vars) = @_;
  12.     $package .= "::" unless $package =~ /::$/;
  13.     *stab = *{"main::"};
  14.     while ($package =~ /(¥w+?::)/g){
  15.     *stab = ${stab}{$1};
  16.     }
  17.     while (($key,$val) = each(%stab)) {
  18.     {
  19.         next if @vars && !grep($key eq $_,@vars);
  20.         local(*entry) = $val;
  21.         if (defined $entry) {
  22.         print "¥$",&unctrl($key)," = '",&unctrl($entry),"'¥n";
  23.         }
  24.         if (defined @entry) {
  25.         print "¥@$key = (¥n";
  26.         foreach $num ($[ .. $#entry) {
  27.             print "  $num¥t'",&unctrl($entry[$num]),"'¥n";
  28.         }
  29.         print ")¥n";
  30.         }
  31.         if ($key ne "main::" && $key ne "DB::" && defined %entry
  32.         && !($package eq "dumpvar" and $key eq "stab")) {
  33.         print "¥%$key = (¥n";
  34.         foreach $key (sort keys(%entry)) {
  35.             print "  $key¥t'",&unctrl($entry{$key}),"'¥n";
  36.         }
  37.         print ")¥n";
  38.         }
  39.     }
  40.     }
  41. }
  42.  
  43. 1;
  44.